home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / dev / lang / pcq12src.lzh / Runtime / Extras / DateTools.p < prev    next >
Text File  |  1990-08-10  |  3KB  |  136 lines
  1. External;
  2.  
  3. {
  4.     DateTools.p of PCQ Pascal
  5.  
  6.     These routines help to use AmigaDOS's DateStamps and Intuition's
  7.     CurrentTime(), which, to save memory, are formatted relatively
  8.     inconveniently.  These routines use DateDescription records,
  9.     which have the Year, Month, etc. formatted in normal human
  10.     form.  This module also exports some typed constants that spell
  11.     out the month and day names in case you've forgotten.
  12.  
  13.     It appears that the DateStamp and the values from Intuition's
  14.     CurrentTime routine are normalized - that is, if the number of
  15.     minutes in a DateStamp, for example, is greater than 1440
  16.     (the number of minutes in a day), it wraps to zero and the
  17.     number of days in incremented.  If it turns out that the
  18.     stamps are not normalized, you'll need to account for the
  19.     minutes using some code in GetDescription that is currently
  20.     commented out.
  21. }
  22.  
  23. {$I "Include:Libraries/DOS.i"}
  24. {$I "Include:Intuition/Intuition.i"}
  25.  
  26. Type
  27.     DaysOfTheWeek = (Sunday, Monday, Tuesday, Wednesday,
  28.             Thursday, Friday, Saturday);
  29.  
  30.     DateDescription = record
  31.     Day    : Byte;            { Day of month, 1..31 }
  32.     Month    : Byte;            { Month, 1..12 }
  33.     Year    : Short;        { Year, 1978... }
  34.     DOW    : DaysOfTheWeek;    { Sunday .. Saturday }
  35.     Hour    : Byte;            { 0..23.  0 = 12 AM, 12 = Noon }
  36.     Minute    : Byte;            { 0..59 }
  37.     Second    : Byte;            { 0..59 }
  38.     end;
  39.  
  40. Const
  41.     MonthNames : Array [1..12] of String =
  42.                ("January",
  43.             "February",
  44.             "March",
  45.             "April",
  46.             "May",
  47.             "June",
  48.             "July",
  49.             "August",
  50.             "September",
  51.             "October",
  52.             "November",
  53.             "December");
  54.  
  55.     DayNames : Array [Sunday..Saturday] of String =
  56.                ("Sunday",
  57.             "Monday",
  58.             "Tuesday",
  59.             "Wednesday",
  60.             "Thursday",
  61.             "Friday",
  62.             "Saturday");
  63.  
  64.     { This array changes if you get a date description for
  65.       a leap year date.  Thus if you are going to use these
  66.       values, make sure you set DaysInMonth[1] to the value
  67.       you need.  Also note that this array is zero based,
  68.       unlike the month names above }
  69.  
  70.     DaysInMonth : Array [0..11] of Byte = (31,28,31,30,31,30,
  71.                        31,31,30,31,30,31);
  72.  
  73.  
  74. { Given Total seconds, figure out the day, month, year, time of day,
  75.   etc. }
  76.  
  77. Procedure GetDescription(Total : Integer; var DD : DateDescription);
  78. var
  79.     Compare : Integer;
  80.     Tally   : Short;
  81. begin
  82.     with DD do begin
  83.     Second    := Total mod 60;
  84.     Minute    := (Total div 60) mod 60;
  85.     Hour    := (Total div 3600) mod 24;
  86.  
  87.     Total := Total div 86400; { Total Days }
  88.     DOW := DaysOfTheWeek(Total mod 7);
  89.     Year := 1978;
  90.     Tally := 2;
  91.     Compare := 365;
  92.     while Total >= Compare do begin
  93.         Total := Total - Compare;
  94.         Inc(Year);
  95.         Inc(Tally);
  96.         Compare := 365;
  97.         if (Tally and 3) = 0 then
  98.         if (Tally mod 100) <> 0 then
  99.             Compare := 366;
  100.     end;
  101.     DaysInMonth[1] := 28;
  102.     if (Tally and 3) = 0 then
  103.         if (Tally mod 100) <> 0 then
  104.         DaysInMonth[1] := 29;
  105.     for Tally := 0 to 11 do begin
  106.         if Total < DaysInMonth[Tally] then begin
  107.         Month := Succ(Tally);
  108.         Day   := Succ(Total);
  109.         return;
  110.         end else
  111.         Total := Total - DaysInMonth[Tally];
  112.     end;
  113.     end;
  114. end;
  115.  
  116.  
  117. {  Get a description for the current time }
  118.  
  119. Procedure TimeDesc(var DD : DateDescription);
  120. var
  121.     Secs, Mics : Integer;
  122. begin
  123.     CurrentTime(Secs,Mics);
  124.     GetDescription(Secs,DD);
  125. { if not normalized, should be: Secs + Mics div 1000000 }
  126. end;
  127.  
  128.  
  129. { Get a description based on a DateStampRec }
  130.  
  131. Procedure StampDesc(DS : DateStampRec; var DD : DateDescription);
  132. begin
  133.     with DS do
  134.     GetDescription(ds_Days * 86400 + ds_Minute * 60 + ds_Tick div 50,DD);
  135. end;
  136.